Read in the data
shot.data <- kobe %>%
filter(!is.na(shot_made_flag))
ggplot() + geom_point(data = shot.data, aes(x = loc_x, y = loc_y + 52, color = as.factor(shot_made_flag)), size = .75) + geom_path(data = test.outer_key, aes(x= x, y = y)) + geom_path(data = test.perimeter, aes(x= x, y = y)) + geom_path(data = test.three, aes(x= x, y = y)) + ylim(-10, 350) +
geom_path(data = test.backboard, aes(x= x, y = y)) +
geom_path(data = test.neck, aes(x= x, y = y)) +
geom_path(data = test.hoop, aes(x= x, y = y)) +
geom_path(data = test.foul_circle, aes(x= x, y = y)) +
geom_path(data = test.restricted, aes(x= x, y = y)) +
coord_fixed() + theme_void() + scale_color_manual(values = c("#fdb927", "#552583"), labels = c("Miss", "Make"), name = "Zone Range") + guides(colour = guide_legend(reverse = TRUE, override.aes = list(size = 5))) +
labs(title = "Kobe Bryant Shot Distance")
team_percentage <- shot.data %>%
group_by(opponent) %>%
summarize(FGPercent = mean(shot_made_flag == 1),
FG2Percent = sum(shot_made_flag == 1 & shot_type == "2PT Field Goal")/sum(shot_type == "2PT Field Goal"),
FG3Percent = sum(shot_made_flag == 1 & shot_type == "3PT Field Goal")/sum(shot_type == "3PT Field Goal"))
team_games <- shot.data %>%
group_by(opponent) %>%
summarize(Games_Against = length(unique(game_id)))
team_percentage <- team_percentage %>% inner_join(team_games, by = "opponent")
team_percentage$conference <- c("East", "East", "East", "East", "East", "East", "West", "West", "East", "West", "West", "East", "West", "West", "East", "East", "West", "East", "West", "West", "East", "West", "East", "East", "West", "West", "West", "West", "West", "East", "West", "West", "East")
team_percentage$conference <- factor(team_percentage$conference)
team_percentage <- team_percentage %>% arrange(desc(FGPercent))
empty_bar <- 10
to_add <- data.frame( matrix(NA, empty_bar*nlevels(team_percentage$conference), ncol(team_percentage)) )
colnames(to_add) <- colnames(team_percentage)
to_add$conference <- rep(levels(team_percentage$conference), each=empty_bar)
team_percentage <- rbind(team_percentage, to_add)
team_percentage <- team_percentage %>% arrange(conference)
team_percentage$id <- seq(1, nrow(team_percentage))
label_data <- team_percentage
number_of_bar <- nrow(label_data)
angle <- 90 - 360 * (label_data$id-0.5) /number_of_bar # I substract 0.5 because the letter must have the angle of the center of the bars. Not extreme right(1) or extreme left (0)
label_data$hjust <- ifelse( angle < -90, 1, 0)
label_data$angle <- ifelse(angle < -90, angle+180, angle)
base_data <- team_percentage %>%
group_by(conference) %>%
summarize(start=min(id), end=max(id) - empty_bar) %>%
rowwise() %>%
mutate(title=mean(c(start, end)))
grid_data <- base_data
grid_data$end <- grid_data$end[ c( nrow(grid_data), 1:nrow(grid_data)-1)] + 1
grid_data$start <- grid_data$start - 1
grid_data <- grid_data[-1,]
ggplot(team_percentage, aes(x=as.factor(id), y=FGPercent*100, fill=conference)) + # Note that id is a factor. If x is numeric, there is some space between the first bar
geom_bar(aes(x=as.factor(id), y=FGPercent*100, fill=conference), stat="identity", alpha=0.5) +
# Add a val=100/75/50/25 lines. I do it at the beginning to make sur barplots are OVER it.
geom_segment(data=grid_data, aes(x = end, y = 80, xend = start, yend = 80), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
geom_segment(data=grid_data, aes(x = end, y = 60, xend = start, yend = 60), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
geom_segment(data=grid_data, aes(x = end, y = 40, xend = start, yend = 40), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
geom_segment(data=grid_data, aes(x = end, y = 20, xend = start, yend = 20), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
# Add text showing the value of each 100/75/50/25 lines
annotate("text", x = rep(max(team_percentage$id),4), y = c(20, 40, 60, 80), label = c("20", "40", "60", "80") , color="grey", size=3 , angle=0, fontface="bold", hjust=1) +
geom_bar(aes(x=as.factor(id), y=FGPercent, fill=conference), stat="identity", alpha=0.5) +
ylim(-50,100) +
theme_minimal() +
theme(
legend.position = "none",
axis.text = element_blank(),
axis.title = element_blank(),
panel.grid = element_blank(),
plot.margin = unit(rep(-1,4), "cm")
) +
coord_polar() +
geom_text(data=label_data, aes(x=id, y=(FGPercent*100)+10, label=paste(opponent, " ", round(FGPercent*100, digits = 2), "%", sep = ""), hjust=hjust), color="black", fontface="bold",alpha=0.6, size=2.5, angle= label_data$angle, inherit.aes = FALSE ) +
# Add base line information
geom_segment(data=base_data, aes(x = start, y = -5, xend = end, yend = -5), colour = "black", alpha=0.8, size=0.6 , inherit.aes = FALSE ) +
geom_text(data=base_data, aes(x = title, y = -18, label=conference), hjust=c(1,0), colour = "black", alpha=0.8, size=4, fontface="bold", inherit.aes = FALSE) + labs(title ="Kobe Bryant Field Goal Percentage by Team") + scale_fill_manual(values = c("#0168ad", "#ed174b"))
shot.type <- shot.data %>%
group_by(action_type) %>%
summarize(FGPercent = round(mean(shot_made_flag) * 100, digits = 2))
ggplot(shot.type, aes(fct_reorder(action_type, FGPercent), FGPercent)) +
geom_bar(stat = "identity", fill = "#fdb927") +
geom_point(color = "#552583") +
xlab("Shot type") +
ylab("Field Goal Percentage") +
coord_flip()
shot.type.small <- shot.data %>%
group_by(combined_shot_type) %>%
summarize(FGPercent = round(mean(shot_made_flag) * 100, digits = 2))
ggplot(shot.type.small, aes(fct_reorder(combined_shot_type, FGPercent), FGPercent)) +
geom_bar(stat = "identity", fill = "#fdb927") +
geom_point(color = "#552583", size = 3) +
xlab("Shot type") +
ylab("Field Goal Percentage") +
coord_flip() + theme_clean()
arena <- read.csv("arenas.csv")
nba.arena <- arena %>% filter(leagueName == "National Basketball Association") %>%
select(teamName, venueName, lat, long)
extra_teams <- data.frame(teamName = c("Vancouver Grizzlies", "Seattle SuperSonics", "New Orleans Hornets", "New Jersey Nets"), venueName = c("Rogers Arena", "Key Arena", "Pete Maravich Assembly Center", "Continental Airlines Arena"), lat = c(49.277836, 47.6200, 30.4143, 40.8116), long = c(-123.108823, -122.3525, -91.1846, -74.0676))
nba.arena <- nba.arena %>% bind_rows(extra_teams) %>%
filter(teamName != "Los Angeles Lakers", teamName != "Indianapolis Olympians") %>%
slice(c(1:2, 5:nrow(.))) %>%
mutate(id = 1:33)
nba.arena$opponent <- c("ATL", "BOS", "BKN", "CHA", "CHI", "CLE", "DAL", "DEN", "DET", "GSW", "HOU", "IND", "LAC", "MEM", "MIA", "MIL", "MIN", "NOP", "NYK", "OKC", "ORL", "PHI", "PHX", "POR", "SAC", "SAS", "TOR", "UTA", "WAS", "VAN", "SEA", "NOH", "NJN")
teams <- team_percentage %>% inner_join(nba.arena, by = "opponent")
mybreaks <- c(.4, .415, .43, .445, .46, .475)
map <- map_data("world") %>% filter(region %in% c("Canada", "USA"))
teams <- teams %>%
mutate(mytext = paste(teamName, "\n", venueName, "\n", "Conference: ", conference , "\n", "Games Against: ", Games_Against, "\n", "Field Goal Percentage: ", round(FGPercent*100, digits = 2), "%", sep = ""))
p <- ggplot() +
geom_polygon(data = map, aes(x=long, y = lat, group = group), fill="grey", alpha=0.7) +
geom_point( data=teams, aes(x=long, y=lat, color=FGPercent, size = FGPercent, text = mytext)) +
scale_size_continuous(range=c(1,5), name = "Field Goal Percent", breaks = mybreaks) +
scale_color_viridis(option = "viridis", name = "Field Goal Percent", breaks = mybreaks) +
theme_void() + coord_fixed(xlim = c(-135, -60), ylim = c(20, 55), ratio = 1.2) + guides( colour = guide_legend()) + theme(legend.position = "bottom")
p.anim <- ggplotly(p, tooltip = "text")
p
p.anim
mytext_leaflet = paste(teams$teamName, "<br/>", teams$venueName, "<br/>", "Conference: ", teams$conference , "<br/>", "Games Against: ", teams$Games_Against, "<br/>", "Field Goal Percentage: ", round(teams$FGPercent*100, digits = 2), "%", sep = "") %>% lapply(htmltools::HTML)
library(leaflet)
mypalette <- colorBin(palette = "viridis", pretty = TRUE, domain = teams$FGPercent)
teams %>%
leaflet() %>%
addProviderTiles("Esri") %>%
addCircleMarkers(lng = ~long, lat = ~lat, label = mytext_leaflet,
color = ~mypalette(FGPercent), radius = 7,
fillOpacity = 1, stroke = FALSE) %>%
addLegend(pal = mypalette, values = ~FGPercent, opacity = .75, title = "Field Goal Percent", position = "bottomleft")
teams %>%
leaflet() %>%
addProviderTiles("Esri") %>%
addCircleMarkers(lng = ~long, lat = ~lat, label = mytext_leaflet,
color = ~mypalette(FGPercent),
fillOpacity = 1, stroke = FALSE, radius = ~(Games_Against/5)) %>%
addLegend(pal = mypalette, values = ~FGPercent, opacity = .75, title = "Field Goal Percent", position = "bottomleft")
library(ggridges)
library(hrbrthemes)
ggplot(kobe.filter, aes(x = shot_distance, y = season, fill = ..x..)) +
geom_density_ridges_gradient(scale = 2, rel_min_height = 0.01) +
scale_fill_viridis(option = "C") +
labs(title = 'Kobe Bryant Shot Distance by Season', y = "", caption = "Shot distance (ft.)") +
theme_fivethirtyeight() +
theme(
legend.position="none",
panel.spacing = unit(0.1, "lines"),
strip.text.x = element_text(size = 8)
)
ggplot(kobe.filter, aes(x = shot_distance, y = as.factor(minutes_remaining), fill = ..x..)) +
geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01) +
scale_fill_viridis(option = "inferno") +
labs(title = 'Kobe Bryant Shot Distance by Minutes Remaining', y = "", x = "Shot distance (ft.)", caption = "Shot distance (ft.)") +
theme_fivethirtyeight() +
theme(
legend.position="none",
panel.spacing = unit(0.1, "lines"),
strip.text.x = element_text(size = 8)
)
ggplot(kobe.filter, aes(x = shot_distance, y = shot_zone_area, fill = ..x..)) +
geom_density_ridges_gradient(scale = 1.5, rel_min_height = 0.01) +
scale_fill_viridis(option = "C") +
labs(title = 'Kobe Bryant Shot Distance by Area', y = "", caption = "Shot distance (ft.)") +
theme_fivethirtyeight() +
theme(
legend.position="none",
panel.spacing = unit(0.1, "lines"),
strip.text.x = element_text(size = 8)
)
season.fg <- shot.data %>%
group_by(season) %>%
summarize(FGPercent = round(mean(shot_made_flag), digits = 4),
Percent2 = sum(shot_made_flag == 1 & shot_type == "2PT Field Goal")/sum(shot_type == "2PT Field Goal"),
percent3 = sum(shot_made_flag == 1 & shot_type == "3PT Field Goal")/sum(shot_type == "3PT Field Goal"))
library(hrbrthemes)
ggplot(season.fg, aes(x = season, y = FGPercent)) +
geom_line(group = 1, color = "gray45") +
geom_point(shape=21, color="black", fill="darkmagenta", size=4) +
theme_fivethirtyeight() + scale_y_percent(limits = c(.33, .48)) + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + labs(title = "Kobe Bryant Field Goal Percentage Over Time")
playoffs <- shot.data %>%
filter(playoffs == 1) %>%
group_by(season) %>%
summarize(FGPercent = round(mean(shot_made_flag), digits = 4),
Percent2 = sum(shot_made_flag == 1 & shot_type == "2PT Field Goal")/sum(shot_type == "2PT Field Goal"),
percent3 = sum(shot_made_flag == 1 & shot_type == "3PT Field Goal")/sum(shot_type == "3PT Field Goal"))
reg.season <- shot.data %>%
filter(playoffs == 0) %>%
group_by(season) %>%
summarize(FGPercent = round(mean(shot_made_flag), digits = 4),
Percent2 = sum(shot_made_flag == 1 & shot_type == "2PT Field Goal")/sum(shot_type == "2PT Field Goal"),
percent3 = sum(shot_made_flag == 1 & shot_type == "3PT Field Goal")/sum(shot_type == "3PT Field Goal"))
ggplot(season.fg, aes(x = season, group = 1)) +
geom_line(data = playoffs, aes(color = "Play", y = FGPercent)) +
geom_line(data = reg.season, aes(color = "Season", y = FGPercent)) +
geom_point(data = playoffs, aes(color = "Play", y = FGPercent), size = 3) +
geom_point(data = reg.season, aes(color = "Season", y = FGPercent), size = 3) +
scale_y_percent(limits = c(.33, .52)) + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "bottom", panel.grid.major.x = element_blank(), panel.grid.major.y = element_line(linetype = "dashed")) + scale_color_manual(name ="", values = c("#195190FF", "#A2A2A1FF"), labels = c("Playoffs", "Regular Season")) + labs(x = "", y = "Percent", title = "Kobe Bryant Field Goal Percentage", subtitle = "Regular Season vs. Playoffs")
ggplot(season.fg, aes(x = season, group = 1)) +
geom_line(aes(color = "Two", y = Percent2)) +
geom_line(aes(color = "Three", y = percent3)) +
geom_point(aes(color = "Two", y = Percent2), size = 3) +
geom_point(aes(color = "Three", y = percent3), size = 3) +
scale_y_percent(limits = c(.15, .52)) + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "bottom", panel.grid.major.x = element_blank(), panel.grid.major.y = element_line(linetype = "dashed")) + scale_color_manual(name ="", values = c("#195190FF", "#A2A2A1FF"), labels = c("2 PT", "3 PT")) + labs(x = "", y = "Percent", title = "Kobe Bryant Percentage", subtitle = "2 PT vs 3 PT")
fg.distance <- shot.data %>%
filter(shot_distance <= 32) %>%
mutate(shot_distance = factor(shot_distance)) %>%
group_by(shot_distance) %>%
summarize(FGPercent = round(mean(shot_made_flag), digits = 4))
ggplot(fg.distance, aes(x = shot_distance, y = FGPercent)) +
geom_line(group = 1, color = "gray45") +
geom_point(shape=21, color="black", fill="darkmagenta", size=4) +
theme_fivethirtyeight() + scale_y_percent(limits = c(0, .7)) + labs(title = "Kobe Bryant Field Goal Percentage Over Time", caption = "Distance (ft.)")
shot.area <- shot.data %>%
filter(shot_distance <= 32) %>%
group_by(shot_zone_basic) %>%
summarize(shots_attempted = length(shot_made_flag),
shots_made = sum(shot_made_flag == 1),
mloc_x = mean(loc_x),
mloc_y = mean(loc_y),
shot_accuracy = shots_made/shots_attempted,
label = paste(round(shot_accuracy*100, digits = 1), "%", sep = ""))
shot.area$mloc_y[shot.area$shot_zone_basic == "Above the Break 3"] <- shot.area$mloc_y[shot.area$shot_zone_basic == "Above the Break 3"] + 30
shot.area$mloc_y[shot.area$shot_zone_basic == "Mid-Range"] <- shot.area$mloc_y[shot.area$shot_zone_basic == "Mid-Range"] + 35
ggplot() + geom_point(data = shot.area, aes(x = mloc_x, y = mloc_y + 69, color = shot_zone_basic), size = 4) + geom_path(data = test.outer_key, aes(x= x, y = y)) + geom_path(data = test.perimeter, aes(x= x, y = y)) + geom_path(data = test.three, aes(x= x, y = y)) + ylim(-10, 350) +
geom_path(data = test.backboard, aes(x= x, y = y)) +
geom_path(data = test.neck, aes(x= x, y = y)) +
geom_path(data = test.hoop, aes(x= x, y = y)) +
geom_path(data = test.foul_circle, aes(x= x, y = y)) +
geom_path(data = test.restricted, aes(x= x, y = y)) +
coord_fixed() + theme_void() + geom_text(data = shot.area, aes(x = mloc_x, y = mloc_y + 96, color =shot_zone_basic, label = label), size =5) + labs(title = "Kobe Bryant Shot Accuracy") + theme(plot.title = element_text(size = 17, face = "bold", hjust = .65), legend.title = element_blank())
shot.area <- shot.area %>%
arrange(shots_attempted) %>%
mutate(shot_zone_basic = factor(shot_zone_basic, shot_zone_basic))
ggplot(data = shot.area, aes(x = fct_reorder(shot_zone_basic, shots_attempted), y = shots_attempted)) +
geom_segment( aes(x=shot_zone_basic, xend=shot_zone_basic, y=0, yend=shots_attempted), color="#E10600FF", alpha = .6, size = .75) +
geom_point( color="#00239CFF", size=6) + theme_light() +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
panel.border = element_blank(),
axis.ticks.y = element_blank()
) + labs(x = "", y = "Number of shots")
shot.types <- shot.data %>%
filter(shot_distance <= 32) %>%
group_by(combined_shot_type) %>%
summarize(shots_attempted = length(shot_made_flag)) %>%
arrange(shots_attempted) %>%
mutate(combined_shot_type = factor(combined_shot_type, combined_shot_type))
ggplot(data = shot.types, aes(x = combined_shot_type, y = shots_attempted)) +
geom_segment( aes(x=combined_shot_type, xend=combined_shot_type, y=0, yend=shots_attempted), color="#E10600FF", alpha = .6, size = .75) +
geom_point( color="#00239CFF", size=6) + theme_light() +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
panel.border = element_blank(),
axis.ticks.y = element_blank()
) + labs(x = "", y = "Number of shots")
periods <- shot.data %>%
filter(shot_distance <= 32) %>%
group_by(period, game_id) %>%
summarize(avg_shots_attempted = length(shot_made_flag)/length(unique(game_id))) %>%
ungroup() %>%
group_by(period) %>%
summarize(avg_shots_q = mean(avg_shots_attempted)) %>%
arrange(avg_shots_q) %>%
mutate(period = factor(period, period))
levels(periods$period) <- c("2OT", "OT", "3OT", "2nd", "4th", "1st", "3rd")
ggplot(data = periods, aes(x = period, y = avg_shots_q)) +
geom_segment( aes(x=period, xend=period, y=0, yend=avg_shots_q), color="#E10600FF", alpha = .6, size = .75) +
geom_point( color="#00239CFF", size=6) + theme_light() +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
panel.border = element_blank(),
axis.ticks.y = element_blank(),
plot.title = element_text(size = 14, face = "bold", hjust = .5)
) + labs(x = "", y = "Average number of shots", title = "Kobe Bryant Average Shots Per Period")
shots.home <- shot.data %>%
mutate(home = ifelse(str_detect(matchup, "@")== FALSE, 1, 0)) %>%
filter(home == 1) %>%
group_by(season) %>%
summarize(FGPercent = round(mean(shot_made_flag), digits = 4),
Percent2 = sum(shot_made_flag == 1 & shot_type == "2PT Field Goal")/sum(shot_type == "2PT Field Goal"),
percent3 = sum(shot_made_flag == 1 & shot_type == "3PT Field Goal")/sum(shot_type == "3PT Field Goal"))
shots.away <- shot.data %>%
mutate(home = ifelse(str_detect(matchup, "@")== FALSE, 1, 0)) %>%
filter(home == 0) %>%
group_by(season) %>%
summarize(FGPercent = round(mean(shot_made_flag), digits = 4),
Percent2 = sum(shot_made_flag == 1 & shot_type == "2PT Field Goal")/sum(shot_type == "2PT Field Goal"),
percent3 = sum(shot_made_flag == 1 & shot_type == "3PT Field Goal")/sum(shot_type == "3PT Field Goal"))
ggplot(season.fg, aes(x = season, group = 1)) +
geom_line(data = shots.home, aes(color = "Home", y = FGPercent)) +
geom_line(data = shots.away, aes(color = "Away", y = FGPercent)) +
geom_point(data = shots.home, aes(color = "Home", y = FGPercent), size = 3) +
geom_point(data = shots.away, aes(color = "Away", y = FGPercent), size = 3) +
scale_y_percent(limits = c(.33, .52)) + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "bottom", panel.grid.major.x = element_blank(), panel.grid.major.y = element_line(linetype = "dashed"), plot.title = element_text(hjust = .5, face = "bold"), plot.subtitle = element_text(hjust = .5)) + scale_color_manual(name ="", values = c("#195190FF", "#A2A2A1FF"), labels = c("Home", "Away")) + labs(x = "", y = "Percent", title = "Kobe Bryant Field Goal Percentage", subtitle = "Home vs. Away")
ggplot(season.fg, aes(x = season, group = 1)) +
geom_line(data = shots.home, aes(color = "Home", y = percent3)) +
geom_line(data = shots.away, aes(color = "Away", y = percent3)) +
geom_point(data = shots.home, aes(color = "Home", y = percent3), size = 3) +
geom_point(data = shots.away, aes(color = "Away", y = percent3), size = 3) +
scale_y_percent(limits = c(0, .45)) + theme_bw() + theme(axis.text.x = element_text(angle = 45, hjust = 1), legend.position = "bottom", panel.grid.major.x = element_blank(), panel.grid.major.y = element_line(linetype = "dashed"), plot.title = element_text(hjust = .5, face = "bold"), plot.subtitle = element_text(hjust = .5)) + scale_color_manual(name ="", values = c("#195190FF", "#A2A2A1FF"), labels = c("Home", "Away")) + labs(x = "", y = "Percent", title = "Kobe Bryant 3PT Percentage", subtitle = "Home vs. Away")
minutes <- shot.data %>%
filter(shot_distance <= 32) %>%
group_by(minutes_remaining) %>%
summarize(shots_attempted = length(shot_made_flag),
FGPercentage = round(mean(shot_made_flag) * 100), digits = 2) %>%
arrange(shots_attempted) %>%
mutate(minutes_remaining = factor(minutes_remaining, minutes_remaining))
ggplot(data = minutes, aes(x = minutes_remaining, y = shots_attempted)) +
geom_segment( aes(x= minutes_remaining, xend= minutes_remaining, y=0, yend=shots_attempted), color="#E10600FF", alpha = .6, size = .75) +
geom_point( color="#00239CFF", size=6) + theme_light() +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
panel.border = element_blank(),
axis.ticks.y = element_blank(),
plot.title = element_text(size = 14, face = "bold", hjust = .5)
) + labs(x = "", y = "Number of shots", title = "Shots for Minutes Remaining in the Quarter")
minutes <- minutes %>%
arrange(FGPercentage) %>%
mutate(minutes_remaining = factor(minutes_remaining, minutes_remaining))
ggplot(data = minutes, aes(x = minutes_remaining, y = FGPercentage)) +
geom_segment( aes(x= minutes_remaining, xend= minutes_remaining, y=0, yend=FGPercentage), color="#E10600FF", alpha = .6, size = .75) +
geom_point( color="#00239CFF", size=6) + theme_light() +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
panel.border = element_blank(),
axis.ticks.y = element_blank(),
plot.title = element_text(size = 14, face = "bold", hjust = .5)
) + labs(x = "", y = "Field Goal Percentage", title = "Percentage for Minutes Remaining in the Quarter")
ggplot() +stat_density_2d(
data = shot.data %>% filter(shot_zone_basic != "Restricted Area"),
aes(x = loc_x, y = loc_y + 52, fill = stat(density / max(density))),
geom = "raster", na.rm = TRUE, contour = FALSE, interpolate = TRUE, n = 300
) + geom_path(data = test.outer_key, aes(x= x, y = y), color = "white") + geom_path(data = test.perimeter, aes(x= x, y = y), color = "white", na.rm = TRUE) + geom_path(data = test.three, aes(x= x, y = y), color = "white") + ylim(-10, 350) +
geom_path(data = test.backboard, aes(x= x, y = y),color = "white") +
geom_path(data = test.neck, aes(x= x, y = y),color = "white") +
geom_path(data = test.hoop, aes(x= x, y = y),color = "white") +
geom_path(data = test.foul_circle, aes(x= x, y = y),color = "white") +
geom_path(data = test.restricted, aes(x= x, y = y),color = "white") +
coord_fixed() + theme_void() + scale_fill_viridis_c(
"Shot Frequency ",
limits = c(0, 1),
breaks = c(0, 1),
labels = c("Lower", "Higher"),
option = "inferno"
) + theme(plot.background = element_rect(fill = "black"),
legend.text = element_text(color = "white"),
legend.title = element_text(color = "white", vjust = 1),
plot.title = element_text(color = "white", hjust = .5, face = "bold"),
legend.position = "bottom",
plot.margin=unit(c(0,0,0,.0), "null"),
panel.background = element_rect(fill = "black"),
strip.background = element_blank(),
plot.subtitle = element_text(color = "white", hjust = .5, face = "bold")) + labs(title = "Kobe Bryant Shot Frequency", subtitle = "Outside of the Restricted Area")
made <- ggplot() +stat_density_2d(
data = shot.data %>% filter(shot_zone_basic != "Restricted Area") %>% filter(shot_made_flag == 1),
aes(x = loc_x, y = loc_y + 52, fill = stat(density / max(density))),
geom = "raster", na.rm = TRUE, contour = FALSE, interpolate = TRUE, n = 300
) + geom_path(data = test.outer_key, aes(x= x, y = y), color = "white") + geom_path(data = test.perimeter, aes(x= x, y = y), color = "white", na.rm = TRUE) + geom_path(data = test.three, aes(x= x, y = y), color = "white") + ylim(-10, 350) +
geom_path(data = test.backboard, aes(x= x, y = y),color = "white") +
geom_path(data = test.neck, aes(x= x, y = y),color = "white") +
geom_path(data = test.hoop, aes(x= x, y = y),color = "white") +
geom_path(data = test.foul_circle, aes(x= x, y = y),color = "white") +
geom_path(data = test.restricted, aes(x= x, y = y),color = "white") +
coord_fixed() + theme_void() + scale_fill_viridis_c(
"Shot Frequency ",
limits = c(0, 1),
breaks = c(0, 1),
labels = c("Lower", "Higher"),
option = "inferno"
) + theme(plot.background = element_rect(fill = "black"),
legend.text = element_text(color = "white"),
legend.title = element_text(color = "white", vjust = 1),
plot.title = element_text(color = "white", hjust = .5, face = "bold"),
legend.position = "bottom",
plot.margin=unit(c(0,0,0,.0), "null"),
panel.background = element_rect(fill = "black"),
strip.background = element_blank(),
plot.subtitle = element_text(color = "white", hjust = .5, face = "bold")) + labs(title = "Kobe Bryant Shot Frequency", subtitle = "Made Baskets")
miss <- ggplot() +stat_density_2d(
data = shot.data %>% filter(shot_zone_basic != "Restricted Area") %>% filter(shot_made_flag == 0),
aes(x = loc_x, y = loc_y + 52, fill = stat(density / max(density))),
geom = "raster", na.rm = TRUE, contour = FALSE, interpolate = TRUE, n = 300
) + geom_path(data = test.outer_key, aes(x= x, y = y), color = "white") + geom_path(data = test.perimeter, aes(x= x, y = y), color = "white", na.rm = TRUE) + geom_path(data = test.three, aes(x= x, y = y), color = "white") + ylim(-10, 350) +
geom_path(data = test.backboard, aes(x= x, y = y),color = "white") +
geom_path(data = test.neck, aes(x= x, y = y),color = "white") +
geom_path(data = test.hoop, aes(x= x, y = y),color = "white") +
geom_path(data = test.foul_circle, aes(x= x, y = y),color = "white") +
geom_path(data = test.restricted, aes(x= x, y = y),color = "white") +
coord_fixed() + theme_void() + scale_fill_viridis_c(
"Shot Frequency ",
limits = c(0, 1),
breaks = c(0, 1),
labels = c("Lower", "Higher"),
option = "inferno"
) + theme(plot.background = element_rect(fill = "black"),
legend.text = element_text(color = "white"),
legend.title = element_text(color = "white", vjust = 1),
plot.title = element_text(color = "white", hjust = .5, face = "bold"),
legend.position = "bottom",
plot.margin=unit(c(0,0,0,.0), "null"),
panel.background = element_rect(fill = "black"),
strip.background = element_blank(),
plot.subtitle = element_text(color = "white", hjust = .5, face = "bold")) + labs(title = "Kobe Bryant Shot Frequency", subtitle = "Missed Baskets")
library(patchwork)
made + miss
ggplot() + coord_fixed() + stat_summary_hex(data = shot.data %>% filter(shot_distance <= 32), aes(x= loc_x, y = loc_y +54, z = shot_made_flag, fill = cut(..value.., c(-1, 50, 100, 200, 500, 3500), na.rm = TRUE)), fun = sum, bins = 10, na.rm = TRUE)+ geom_path(data = test.outer_key, aes(x= x, y = y), color = "black") + geom_path(data = test.perimeter, aes(x= x, y = y), color = "black", na.rm = TRUE) + geom_path(data = test.three, aes(x= x, y = y), color = "black") + ylim(-10, 350) +
geom_path(data = test.backboard, aes(x= x, y = y),color = "black") +
geom_path(data = test.neck, aes(x= x, y = y),color = "black") +
geom_path(data = test.hoop, aes(x= x, y = y),color = "black") +
geom_path(data = test.foul_circle, aes(x= x, y = y),color = "black") +
geom_path(data = test.restricted, aes(x= x, y = y),color = "black") + theme_void() +
scale_fill_brewer(palette = "OrRd", labels = c("0-50", "50-100", "100-200", "200-500", "500-3500"), name = "Number of \nMade Shots") + labs(title = "Kobe Bryant Made Shots") + theme(plot.title = element_text(hjust = .5, face = "bold"))
ggplot(data = shot.data) + coord_fixed() + stat_summary_hex(data = shot.data %>% filter(shot_distance <= 32), aes(x= loc_x, y = loc_y +52, z = shot_made_flag, fill = cut(..value.., c(-Inf, .3, .4, .45, .5, .6, Inf), na.rm = TRUE)), fun = mean, bins = 10, na.rm = TRUE)+ geom_path(data = test.outer_key, aes(x= x, y = y), color = "black") + geom_path(data = test.perimeter, aes(x= x, y = y), color = "black", na.rm = TRUE) + geom_path(data = test.three, aes(x= x, y = y), color = "black") + ylim(-10, 350) +
geom_path(data = test.backboard, aes(x= x, y = y),color = "black") +
geom_path(data = test.neck, aes(x= x, y = y),color = "black") +
geom_path(data = test.hoop, aes(x= x, y = y),color = "black") +
geom_path(data = test.foul_circle, aes(x= x, y = y),color = "black") +
geom_path(data = test.restricted, aes(x= x, y = y),color = "black") + theme_void() +
scale_fill_brewer(palette = "OrRd", labels = c("0-30%", "30-40%", "40-45%", "45-50%", "50-60%", "60+%"), name = "Field Goal \nPercent") + labs(title ="Kobe Bryant Shooting Percentage by Location") +
theme(plot.title = element_text(hjust = .8, face = "bold"))
eighty_one <- kobe %>%
filter(game_date == "2006-01-22")
eighty_one$shot_made_flag[c(17, 24, 31, 37, 38, 42, 44)] <- c(1, 1, 1, 1, 0, 1, 1)
library(lubridate)
library(ggalt)
library(gganimate)
game <- eighty_one %>% mutate(gtime=ms(as.character(paste(minutes_remaining,seconds_remaining,sep = ":")))) %>%
mutate(time_chron=case_when(
period==1~ms("12:00")-gtime,
period==2~ms("24:00")-gtime,
period==3~ms("36:00")-gtime,
period==4~ms("48:00")-gtime))
game <- game %>%
mutate(distTrans=ifelse(shot_distance ==0,.8,shot_distance))
source("https://raw.githubusercontent.com/toddwschneider/ballr/master/plot_court.R")
source("https://raw.githubusercontent.com/toddwschneider/ballr/master/court_themes.R")
court_hide <- plot_court(court_theme = court_themes$light) # created the court_points object we need
court_points <- court_points %>% mutate_if(is.numeric,~.*10)
DBcourt <- ggplot(game, aes(x=loc_x, y=loc_y+47)) +
geom_point(aes(fill=as.factor(shot_made_flag), shape = as.factor(shot_made_flag)),size=3.5) +
scale_fill_manual(values = c("#fdb927","#552583"), name = "", labels = c("Missed", "Made")) +
scale_shape_manual(values = c(25, 21), name = "", labels = c("Missed", "Made")) +
geom_path(data = court_points,
aes(x = x, y = y, group = desc))+
coord_equal()+
xlim(-260, 260) +
labs(title="Kobe Bryant Shot Chart",subtitle= "81 point game", x="",
y="") + guides(color=guide_legend(override.aes=list(fill=NA))) +
theme(text = element_text(size = 19),
panel.grid = element_blank(),
axis.text = element_blank(),
plot.caption = element_text(color="white"),
legend.position = "bottom",
plot.background = element_rect(color = "white"),
plot.title = element_text(hjust = .5, face = "bold"),
plot.subtitle = element_text(hjust = .5, face = "bold"),
legend.key = element_rect(color = "white")) +
transition_states(game_event_id)+shadow_mark()
animate(DBcourt, fps = 2)